#!/usr/bin/perl

package Swignition::Export::Event;
use Swignition::Export;
use Swignition::Export::Alarm;
use Swignition::Export::Contact;
use MIME::Base64;

sub is
{
	my $subject = shift;
	return unless ($subject);
	return unless (ref $subject eq 'Swignition::RDFModel::Subject');	
	return
		unless (defined $subject->property('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'));
	foreach my $Type ( @{$subject
		->property('http://www.w3.org/1999/02/22-rdf-syntax-ns#type')
		->valObjects} )
	{
		my $type = $Type->toString;
		return 1
			if (($type eq 'http://www.w3.org/2002/12/cal/ical#Vevent')
			||  ($type eq 'urn:ietf:rfc:2445#Vevent'));
	}
	
	if (firstOf($subject,
		'http://purl.org/rss/1.0/modules/event/startdate',
		'http://purl.org/rss/1.0/modules/event/enddate',
		'http://purl.org/rss/1.0/modules/event/location',
		'http://purl.org/rss/1.0/modules/event/organizer',
		'http://purl.org/rss/1.0/modules/event/type'))
	{
		return 1;
	}
	
	return;
}

sub outputs
{
	return [
		{
			code  => 'ICS',
			name  => 'iCalendar',
			type  => 'text/directory',
			multi => 1
		}
	];
}

sub outICS
{
	return "BEGIN:VCALENDAR\r\n"
		. _outICS(@_)
		. "END:VCALENDAR\r\n";
}

sub multiICS
{
	my $triples = shift;
	my $rv = '';
	foreach my $s (keys %$triples)
	{
		$rv .= _outICS($triples, $s)
			if (defined $triples->{$s} && is($triples->{$s}));
	}

	return "BEGIN:VCALENDAR\r\n"
		. $rv
		. "END:VCALENDAR\r\n";
}

sub _outICS
{
	my $triples = shift;
	my $subject = shift;
	my $S = findSubject($triples, $subject);
	my @rv = (['BEGIN','VEVENT']);

	# UID
	my $uid = firstOf($S, 'urn:ietf:rfc:2445#uid',
		'http://www.w3.org/2002/12/cal/ical#uid',
		'http://purl.org/dc/terms/identifier',
		'http://purl.org/dc/elements/1.1/identifier');
	push @rv, ['UID', $uid]
		if ($uid);
	
	# Summary
	my $summary = firstOfLiteral($S, 
		['urn:ietf:rfc:2445#summary',
		'http://www.w3.org/2002/12/cal/ical#summary',
		'http://purl.org/rss/1.0/title',
		'urn:ietf:rfc:4287#title',
		'http://purl.org/dc/terms/title',
		'http://purl.org/dc/elements/1.1/title'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['SUMMARY', $summary]
		if ($summary);
	
	# Comment, Description
	my $desc = firstOfLiteral($S, 
		['urn:ietf:rfc:2445#comment',
		'http://www.w3.org/2002/12/cal/ical#comment',
		'http://purl.org/dc/terms/abstract'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['COMMENT', $desc]
		if ($desc);
	my @desc = allOfLiteral($S,
		['urn:ietf:rfc:2445#description',
		'http://www.w3.org/2002/12/cal/ical#description',
		'http://purl.org/rss/1.0/description',
		'urn:ietf:rfc:4287#content',
		'http://purl.org/dc/terms/description',
		'http://purl.org/dc/elements/1.1/description'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	foreach my $desc (@desc)
		{ push @rv, ['DESCRIPTION', $desc]; }
	
	# Location
	my $loc = firstOf($S, 'urn:ietf:rfc:2445#location',
		'http://www.w3.org/2002/12/cal/ical#location',
		'http://purl.org/rss/1.0/modules/event/location');
	my $Loc = findSubject($triples, $loc);
	if ($Loc)
		{ push @rv, ['LOCATION', Swignition::Export::Location::outText($triples, $Loc->uri)]; }
	else
		{ push @rv, ['LOCATION', $loc] if (length $loc); }
		
	# Geo
	my @geos = allOfObj($S, 'urn:ietf:rfc:2445#geo',
		'http://www.w3.org/2002/12/cal/ical#location');
	foreach my $geo (@geos)
	{
		my $geoSubject = findSubject($triples, $geo->toString);
		if ($geoSubject)
		{
			if (Swignition::Export::Point::is($geoSubject))
			{
				my ($key, $val) = Swignition::Export::Point::outVCFLine($triples, $geoSubject->uri);
				push @rv, [$key, $val, 1];
			}
		}
	}

	# Taxonomy
	my @species = allOfObj($S,
		'http://purl.org/NET/biol/auxiliary#sightingOf');
	foreach my $species (@species)
	{
		my $speciesSubject = findSubject($triples, $species->toString);
		if ($speciesSubject)
		{
			if (Swignition::Export::Taxonomy::is($speciesSubject))
			{
				my $val = Swignition::Export::Taxonomy::outText($triples, $speciesSubject->uri);
				push @rv, ['X-SIGHTING-OF', $val];
			}
		}
		elsif (!$species->type)
		{
			push @rv, ['X-SIGHTING-OF', $species->toString, 1];
		}
	}

	# Categories
	my @cats = allOfObj($S, 'urn:ietf:rfc:2445#categories',
		'http://www.w3.org/2002/12/cal/ical#categories',
		'http://purl.org/rss/1.0/modules/event/type',
		'http://www.holygoat.co.uk/owl/redwood/0.1/tags/taggedWithTag');
	my $catstring = '';
	foreach my $cat (@cats)
	{
		my $catSubject = findSubject($triples, $cat->toString);
		if ($catSubject)
		{
			my $category = firstOfLiteral($catSubject,
				['http://www.holygoat.co.uk/owl/redwood/0.1/tags/name',
				'http://www.w3.org/1999/02/22-rdf-syntax-ns#value',
				'http://purl.org/dc/terms/title',
				'http://purl.org/dc/elements/1.1/title'],
				['urn:ietf:rfc:2445#value',
				'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
			$catstring .= ','.uc($category)
				if (length $category);
		}
		else
		{
			my $category = $cat->toString;
			$category =~ s/(^\s+|\s+$)//g;
			$category =~ s/\s+/ /g;
			$catstring .= ','.uc($category);
		}
	}
	$catstring =~ s/^\,//;
	push @rv, ['CATEGORIES',$catstring,1]
		if ($catstring);

	# Resources
	@cats = allOfObj($S, 'urn:ietf:rfc:2445#resources',
		'http://www.w3.org/2002/12/cal/ical#resources');
	$catstring = '';
	foreach my $cat (@cats)
	{
		my $catSubject = findSubject($triples, $cat->toString);
		if ($catSubject)
		{
			my $category = firstOfLiteral($catSubject,
				['http://www.holygoat.co.uk/owl/redwood/0.1/tags/name',
				'http://www.w3.org/1999/02/22-rdf-syntax-ns#value',
				'http://purl.org/dc/terms/title',
				'http://purl.org/dc/elements/1.1/title'],
				['urn:ietf:rfc:2445#value',
				'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
			$catstring .= ','.uc($category)
				if (length $category);
		}
		else
		{
			my $category = $cat->toString;
			$category =~ s/(^\s+|\s+$)//g;
			$category =~ s/\s+/ /g;
			$catstring .= ','.uc($category);
		}
	}
	$catstring =~ s/^\,//;
	push @rv, ['RESOURCES',$catstring,1]
		if ($catstring);

	# Related-To;RelType=Child
	my @kids = allOf($S,
		'http://buzzword.org.uk/rdf/icalx#child',
		'urn:ietf:rfc:2445#child');
	foreach my $kid (@kids)
	{
		my $kidSubject = findSubject($triples, $kid);
		if ($kidSubject)
		{
			my $kUid = firstOf($kidSubject, 'urn:ietf:rfc:2445#uid',
				'http://www.w3.org/2002/12/cal/ical#uid',
				'http://purl.org/dc/terms/identifier',
				'http://purl.org/dc/elements/1.1/identifier');
			if ($kUid)
			{
				push @rv, ['RELATED-TO;RELTYPE=CHILD', $kUid]
			}
		}
	}

	# Related-To;RelType=Sibling
	my @sibs = allOf($S, 'urn:ietf:rfc:2445#sibling',
		'http://buzzword.org.uk/rdf/icalx#sibling',
		'http://www.w3.org/2002/12/cal/ical#relatedTo');
	foreach my $sib (@sibs)
	{
		my $sibSubject = findSubject($triples, $sib);
		if ($sibSubject)
		{
			my $sUid = firstOf($triples->{$sib}, 'urn:ietf:rfc:2445#uid',
				'http://www.w3.org/2002/12/cal/ical#uid',
				'http://purl.org/dc/terms/identifier',
				'http://purl.org/dc/elements/1.1/identifier');
			if ($sUid)
			{
				push @rv, ['RELATED-TO;RELTYPE=SIBLING', $sUid]
			}
		}
	}

	# Related-To;RelType=Parent
	my $parent = firstOf($S,
		'http://buzzword.org.uk/rdf/icalx#parent',
		'urn:ietf:rfc:2445#parent');
	if ($parent)
	{
		my $parentSubject = findSubject($triples, $parent);
		if ($parentSubject)
		{
			my $pUid = firstOf($parentSubject, 'urn:ietf:rfc:2445#uid',
				'http://www.w3.org/2002/12/cal/ical#uid',
				'http://purl.org/dc/terms/identifier',
				'http://purl.org/dc/elements/1.1/identifier');
			if ($pUid)
			{
				push @rv, ['RELATED-TO;RELTYPE=PARENT', $pUid]
			}
		}
	}

	# DTStart, DTEnd, DTStamp, Duration, Last-Modified, Created
	my $dt = firstOfLiteral($S, 
		['urn:ietf:rfc:2445#dtstart',
		'http://www.w3.org/2002/12/cal/ical#dtstart',
		'http://purl.org/rss/1.0/modules/event/startdate'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['DTSTART', Swignition::Export::CalComponent::_dt($dt)] if ($dt);
	$dt = firstOfLiteral($S, 
		['urn:ietf:rfc:2445#dtend',
		'http://www.w3.org/2002/12/cal/ical#dtend',
		'http://purl.org/rss/1.0/modules/event/enddate'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['DTEND', Swignition::Export::CalComponent::_dt($dt)] if ($dt);
	$dt = firstOfLiteral($S, 
		['urn:ietf:rfc:2445#dtstamp',
		'http://www.w3.org/2002/12/cal/ical#dtstamp',
		'http://purl.org/dc/terms/modified',
		'http://purl.org/dc/terms/date',
		'http://purl.org/dc/elements/1.1/date'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['DTSTAMP', Swignition::Export::CalComponent::_dt($dt)] if ($dt);
	$dt = firstOfLiteral($S,
		['urn:ietf:rfc:2445#duration',
		'http://www.w3.org/2002/12/cal/ical#duration'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['DURATION', $dt] if ($dt);
	$dt = firstOfLiteral($S, 
		['urn:ietf:rfc:2445#last-modified',
		'http://www.w3.org/2002/12/cal/ical#lastModified',
		'http://purl.org/dc/terms/modified',
		'http://purl.org/dc/terms/date',
		'http://purl.org/dc/elements/1.1/date'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['LAST-MODIFIED', Swignition::Export::CalComponent::_dt($dt)] if ($dt);
	$dt = firstOfLiteral($S, 
		['urn:ietf:rfc:2445#created',
		'http://www.w3.org/2002/12/cal/ical#created',
		'http://purl.org/dc/terms/available',
		'http://purl.org/dc/terms/created'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['CREATED', Swignition::Export::CalComponent::_dt($dt)] if ($dt);
	
	# Due, Completed - Technically only for vtodo, but it makes things much
	# easier if we just accept it for vtodo too.
	$dt = firstOfLiteral($S, 
		['urn:ietf:rfc:2445#due',
		'http://www.w3.org/2002/12/cal/ical#due'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['DUE', Swignition::Export::CalComponent::_dt($dt)] if ($dt);
	$dt = firstOfLiteral($S,
		['urn:ietf:rfc:2445#completed',
		'http://www.w3.org/2002/12/cal/ical#completed'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['COMPLETED', Swignition::Export::CalComponent::_dt($dt)] if ($dt);
	
	# RDATE, RRULE, EXDATE, EXRULE
	foreach my $p (@{['rdate', 'rrule', 'exdate', 'exrule']})
	{
		my @R = allOfLiteral($S,
			['urn:ietf:rfc:2445#'.$p,
			'http://www.w3.org/2002/12/cal/ical#'.$p],
			['urn:ietf:rfc:2445#value',
			'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
		if ($p =~ /date$/)
		{
			foreach my $r (@R)
				{ push @rv, [uc($p), Swignition::Export::CalComponent::_dt($r), 1]; }
		}
		else
		{
			foreach my $r (@R)
				{ push @rv, [uc($p), $r, 1]; }
		}
	}
	# Recurrence-ID
	my $rid = firstOf($S, 'urn:ietf:rfc:2445#recurrence-id',
		'http://www.w3.org/2002/12/cal/ical#recurrenceId');
	push @rv, ['RECURRENCE-ID', $rid]
		if ($rid);

	# URL
	my $url = firstOf($S, 'urn:ietf:rfc:2445#url',
		'http://www.w3.org/2002/12/cal/ical#url');
	push @rv, ['URL', $url]
		if ($url);
	
	# Nested alarms
	my @va = allOf($S, 'http://buzzword.org.uk/rdf/icalx#valarm', 'urn:ietf:rfc:2445#valarm');
	foreach my $va (@va)
	{
		my $VA = findSubject($triples, $va);
		if (Swignition::Export::Alarm::is($VA))
			{ push @rv, ['VALARM', Swignition::Export::Alarm::_outICS($triples, $VA->uri) ]; }
	}
	
	# Attach
	my @attachments = allOfObj($S, 'urn:ietf:rfc:2445#attach',
		'http://www.w3.org/2002/12/cal/ical#attach',
		'http://www.iana.org/assignments/relation/enclosure',
		'http://purl.org/dc/terms/hasPart',
		'urn:ietf:rfc:4287#enclosure');
	foreach my $att (@attachments)
	{
		my $Att = findSubject($triples, $att->toString);
		if ($Att)
		{
			my $e = $Att->firstVal('http://www.iana.org/assignments/relation/enclosure');
			push @rv, ['ATTACH;VALUE=uri',$e] if ($e);
		}
		elsif ($att->type)
		{
			push @rv, ['ATTACH;VALUE=uri',$att->toString];
		}
		else
		{
			push @rv, ['ATTACH',$att->toString];
		}
	}

	# Class, Status, Transp
	my $class = firstOfLiteral($S,
		['urn:ietf:rfc:2445#class',
		'http://www.w3.org/2002/12/cal/ical#class'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['CLASS', uc($class)]
		if ($class);
	$class = firstOfLiteral($S, 
		['urn:ietf:rfc:2445#status',
		'http://www.w3.org/2002/12/cal/ical#status'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['STATUS', uc($class)]
		if ($class);
	$class = firstOfLiteral($S,
		['urn:ietf:rfc:2445#transp',
		'http://www.w3.org/2002/12/cal/ical#transp'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['TRANSP', uc($class)]
		if ($class);
	$class = firstOfLiteral($S,
		['urn:ietf:rfc:2445#priority',
		'http://www.w3.org/2002/12/cal/ical#priority'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['PRIORITY', uc($class)]
		if ($class);

	# Sequence	
	my $seq = firstOfLiteral($S,
		['urn:ietf:rfc:2445#sequence',
		'http://www.w3.org/2002/12/cal/ical#sequence'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	push @rv, ['SEQUENCE', $seq] if ($seq);

	# Percent Complete - Technically only for vtodo, but it makes things much
	# easier if we just accept it for vevent too.
	my $pc = firstOfLiteral($S,
		['urn:ietf:rfc:2445#percent-complete',
		'http://www.w3.org/2002/12/cal/ical#percentComplete'],
		['urn:ietf:rfc:2445#value',
		'http://www.w3.org/1999/02/22-rdf-syntax-ns#value']);
	if ($pc)
	{
		$pc = sprintf("%d%%", $pc);
		push @rv, ['PERCENT-COMPLETE', $pc];
	}

	# Attendees, Contact, Organizer
	push @rv, Swignition::Export::CalComponent::_people($triples, $S, 'aco');

	# Done.
	push @rv, ['END','VEVENT'];
	
	# Convert to text/directory syntax.
	my $rv = '';
	foreach my $line (@rv)
	{
		my ($k, $v, $soft) = @{$line};
		
		if ($k =~ /VALUE.uri$/i && $v =~ /^data\:/)
		{
			my $uri = URI->new($v);
			$v = encode_base64($uri->data, '');
			$k =~ s/VALUE.uri$/ENCODING\=b/i;
			$k .= ';TYPE='.$uri->media_type
				if ($uri->media_type);
		}
		
		$v =~ s/\\/\\\\/g;
		$v =~ s/\r?\n/\\n/g;
		unless ($soft)
		{
			$v =~ s/\;/\\\;/g;
			$v =~ s/\,/\\\,/g;
		}
		
		if (($k =~ /^(DTSTART|DTEND|DTSTAMP|LAST-MODIFIED|CREATED|EXDATE|RDATE|DUE|COMPLETED)$/)
		&&  (8==length $v))
		{
			$k .= ';VALUE=DATE'
		}
		
		$rv .= "$k:$v\r\n";
	}
	return $rv;
}

1;
